Apple II Magazines (DO)

home *** CD-ROM | disk | FTP | other *** search

/ Apple II Magazines (DO) / Nibble Volume 12, No. 05 (1991-05)(MindCraft Publishing)(Side B).zip / Nibble Volume 12, No. 05 (1991-05)(MindCraft Publishing)(Side B).do / PROFINDER.S1.txt < prev next >

Wrap

Text File | 1996-12-24 | 24KB | 864 lines

********************************************* * PROFINDER.S1 * * ProFinder source code, Part 1 * * by Paul L. Esser * * (C) 1991 BY MindCraft Publ. Corp. * * Lincoln, Mass. 01773 * * ProDOS Editor/Assembler * ********************************************* MACLIB ;Enable macros MSB OFF ;All ASCII has high bit off * ------------------ * EQUATES * Monitor PRBL2 EQU $F94A ;Print X spaces TABV EQU $FB5B ;Vtab to A BASCALC EQU $FBC1 ;Calculate BASL VTAB EQU $FC22 ;Vtab to CV ($25) CLEOP EQU $FC42 ;Clear to end of page HOME EQU $FC58 ;Home CLEOL EQU $FC9C ;Clear to end of line RDKEY EQU $FD0C ;Read keybd GETLN EQU $FD6A ;Input line CROUT EQU $FD8E ;Output CR PRBYTE EQU $FDDA ;Print hex byte COUT EQU $FDED ;Output char. MOVE EQU $FE2C ;Move memory block BELL EQU $FF3A ;Ring bell CH EQU $24 ;Screen cursor horiz. pos. BASL EQU $28 ;Screen base address KBD EQU $C000 ;Keyboard data STROBE EQU $C010 ;Clear keybd strobe * * ProDOS Global Page DEVCNT EQU $BF31 ; # disk drives DEVLST EQU $BF32 ;list of disk drives BITMAP EQU $BF58 ;map of protected memory pages LEVEL EQU $BF94 ;open file level MACHID EQU $BF98 ;machine ID byte PFXPTR EQU $BF9A ; 0: no prefix; >0: prefix set * * ASCII codes LARROW EQU $08 ;left arrow DARROW EQU $0A ;down " UARROW EQU $0B ;up " CR EQU $0D ;return RARROW EQU $15 ;right arrow ESC EQU $1B ;escape SPACE EQU $20 ;space DEL EQU $7F ;delete key * * Memory Use IOBUFFER EQU $0800 ;I/O buffer for open files DIRSTACK EQU $0E00 ;stack of menu choice numbers T.NAMELEN EQU $0F00 ;table of name lengths of file entries DIRLOAD EQU $6000 ;location to read dir file MAXDIRSIZ EQU $9800-DIRLOAD ;max length to read dir file ENTLEN EQU DIRLOAD+$23 ;length of each dir entry ENTPERBLK EQU DIRLOAD+$24 ; # entries per dir block FILECOUNT EQU DIRLOAD+$25 ; # files in directory PN2 EQU $280 ;Secondary pathname (Must be at $280) PN2L EQU PN2 ;length byte of PN2 PN2S EQU PN2+1 ;PN2 string PNB EQU $C80 ;Pathname of loaded BASIC.SYSTEM file PND EQU $D80 ;Pathname of current directory STARTUP EQU $2006 ;Pathname of BASIC.SYSTEM's Startup file * * Page Zero Use DSECT ORG $5A NUMBER DS 5 ;Decimal no. in ASCII TEMP DS 1 ;Temporary storage ENTPTR DS 2 ;Pointer to file entries in directory MENUPTR DS 2 ;Pointer to entries in menu MEMLO DS 2 ;Lowest location avail. for copying file MEMHI DS 2 ;Highest " " ACTIVEENT DS 1 ; # active entries in menu BLKENT DS 1 ;counter of file entries in dir block F.BASIC DS 1 ;flag >=$80: BASIC.SYSTEM loaded F.EOF DS 1 ;flag >=$80: EOF reached while copying F.SWAP DS 1 ;flag >=$80: user swapping disks in copy STARTPOS DS 1 ;starting cursor pos (w/in PN1) in INPUTPN ENDPOS DS 1 ;ending " " CHRPTR DS 2 ;pointer to char in PRINT routine TOPENT DS 1 ;menu entry no. displayed highest on scrn MENUNUM DS 1 ;current menu entry no. CHOICE DS 1 ;user's current entry choice in MENU DIRLEVEL DS 1 ;directory level, 0: in Volume Com- ; mands Menu, 1: in root directory, >=2: in subdirectory CMDLIST DS 2 ;list of acceptable cmds in MENU NUMCMDS DS 1 ; # of acceptable cmds VAL DS 2 ;value used in DEC routine AUX DS 1 ;auxillary value GOTO DS 2 ;indirect JMP pointer ORG $80 PN1 EQU * ;Primary pathname (must be at $80) PN1L DS 1 ;Length byte of PN1 PN1S DS 64 ;PN1 string buffer DS 1 STARTMARK DS 3 ;Mark in source file where reading began ENDMARK DS 3 ; " " where last read ended P.MARK DS 1 ;GET_MARK and SET_MARK parameter table MARKRNUM DS 1 ; reference no. MARK DS 3 ; MARK position in file P.EOF DS 1 ;GET_EOF and SET_EOF parm table EOFRNUM DS 1 ; ref no. EOF DS 3 ; EOF position P.CLOSE DS 1 ;CLOSE parm table CLOSERNUM DS 1 ; ref no P.RW DS 1 ;READ and WRITE parm table RWRNUM DS 1 ; ref no RWDATA DS 2 ; location to start read/write RWCOUNT DS 2 ; # of bytes to read/write RWTRANS DS 2 ; # of bytes actually read/written P.INFO DS 1 ;GET_FILE_INFO and SET_FILE_INFO parm tbl INFOPN DS 2 ; pathname, set to PN1 INFOACC DS 1 ; access code INFOTYP DS 1 ; file type INFOAUX DS 2 ; auxillary type INFOSTO DS 1 ; storage type INFOBLKS DS 2 ; # blocks used DS 4 ; modified date,time INFOCDAT DS 4 ; created date,time P.INFO2 DS 1 ;Second GET_FILE_INFO parm table INFO2PN DS 2 ; pathname DS 1 ; access code INFO2TYP DS 1 ; file type DS 13 ; rest of parm table DEND * --------------------- * INITIALIZATION * --------------------- ORG $1000 * CLD LDA $C082 ;activate monitor ROM LDX #$FF TXS ;initialize stack LDA #$00 STA $3F2 ;set RESET vector to $1000 LDA #$10 STA $3F3 EOR #$A5 STA $3F4 LDX #1 ;initialize parm tables in page zero STX P.CLOSE INX STX P.EOF STX P.MARK LDX #4 STX P.RW LDA #>PN1 STA INFOPN LDA #<PN1 STA INFOPN+1 STA $C00C ;turn off 80 column display STA $C00E STA $C000 JSR $FE93 ;PR#0 JSR $FE89 ;IN#0 JSR $FE84 ;NORMAL JSR $FB2F ;TEXT JSR CLOSEALL ;close all files LDA #0 LDX #$17 INIT1 STA BITMAP,X ;initialize bitmap DEX ;(free all pages except 0,1,4,5,6,7,$BF) BNE INIT1 INC BITMAP+$17 LDA #$CF STA BITMAP LDA #$EF ;Check chkpoints in program which should CMP CHKPOINT1 ;have $EF bytes. If the $EF byte BNE FALLOUT ;isn't there, then part of program must CMP CHKPOINT2 ;have been erased, so go to FALLOUT BNE FALLOUT ;routine. JMP START ;If OK, execute program as normal. * FALLOUT JSR HOME ;FALLOUT: loads an application program PRINT M.FALLOUT LDA #0 STA PN2L MLI $C6,P.PREFIX, ;SET_PREFIX to a null prefix LDA #$BF ;Use "?" character as prompt STA $33 FT1 JSR GETLN ;Get pathname from user JSR CROUT STX PN1L DEX CPX #$40 ;If nothing input or pathname >64 chars, BCS FT1 ;then try again FT2 LDA $200,X STA PN1S,X ;Move pathname from input buffer to PN1 DEX BPL FT2 JSR READSYS ;Read in system file BCC RUNSYS ;If no error, run it. JSR PRERR ;If error, print err message and try again JMP FT1 M.FALLOUT ASC 'Enter full pathname of application' DFB CR,CR+128 * * Run a system program loaded at $2000 RUNSYS JSR MOVPN12 ;Move system pathname to $280 (required) JSR HOME ;Clear screen STA STROBE ;and keyboard JMP $2000 ;Execute system program * * MOVPN routines: Move pathnames to or from PN1 MOVPN12 LDX #<PN2 ;move PN1 to PN2 MOVPN1X TXA ;move PN1 to PN(X-reg) LDX #<PN1 JMP MOVPN MOVPN21 LDX #<PN2 ;move PN2 to PN1 MOVPNX1 LDA #<PN1 ;move PN(X-reg) to PN1 MOVPN STA $43 STX $3D ;set up for monitor MOVE routine STX $3F LDA #$80 ;Note: These routines assume STA $3C ;that all pathnames are stored STA $42 ;at $xx80 LDA #$C0 STA $3E LDY #0 JMP MOVE * * DOPRINT: Print string (call with pointer in A low, Y high). * Printing stops at byte with high bit on (negative ASCII). * DCI directive creates string with last byte only having high bit on DOPRINT STA CHRPTR ;set up pointer STY CHRPTR+1 PRINT1 LDY #0 LDA (CHRPTR),Y ;get char BMI PRINTA ;if high bit on, it is last char to print JSR PRINTA ;otherwise print it and get another JMP PRINT1 PRINTA ORA #$80 BIT MACHID ;if running on a II Plus BMI PRINTA1 ;then convert lowercase to upper CMP #$E0 BCC PRINTA1 AND #$DF PRINTA1 JSR COUT ;output char INC CHRPTR ;increment pointer BNE RTS6 INC CHRPTR+1 RTS6 RTS * * Print error message. Call with error code in A. PRERR LDX #NERRCODES-1 PRERR1 CMP ERRCODES,X ;Compare with list of known error codes BEQ PRERR2 DEX BPL PRERR1 PHA ;If unknown error code, PRINT E27, ;then print "I/O ERROR $xx" JSR PRINT1 PLA JSR PRBYTE JMP PRERR4 PRERR2 LDY #<ERRMSG ;If known error code, LDA ERRTABLE,X ;print error message in table CMP #>ERRMSG BCS PRERR3 INY PRERR3 JSR DOPRINT PRERR4 JSR BELL ;ring bell CROUT2 JSR CROUT ;output 2 CR's JMP CROUT ;Note: CROUT2 is called independently * ERRCODES DFB $27,$28,$2B,$40,$44,$45,$46,$47,$48,$49,$4B,$4E,$52 DFB $80,$81,$82,$83,$84 NERRCODES EQU *-ERRCODES ERRTABLE DFB E27,E28,E2B,E40,E44,E45,E46,E47,E48,E49,E4B,E4E,E52 DFB E80,E81,E82,E83,E84 ERRMSG EQU * E27 DCI 'I/O ERROR' ;The following are MLI errors DCI ' $' E28 DCI 'NO DEVICE CONNECTED' E2B DCI 'WRITE PROTECTED' E40 DCI 'BAD PATHNAME' E44 EQU * E45 EQU * E46 DCI 'PATH NOT FOUND' E47 DCI 'DUPLICATE FILE NAME' E48 DCI 'DISK FULL' E49 DCI 'DIRECTORY FULL' E4B DCI 'FILE TYPE MISMATCH' E4E DCI 'FILE LOCKED' E52 DCI 'NON-PRODOS DISK' E80 DCI 'BASIC.SYSTEM NOT FOUND' ;The following are NOT E81 DCI 'BAD VERSION OF BASIC' ;MLI errors, they are E82 DCI 'NO PREFIX' ;specific to this E83 DCI 'PREFIX NOT FOUND' ;program E84 DCI 'FILE IS SPARSE' * * MLI Parameter tables. (Some are here, others are in Page Zero.) P.OPEN DFB 3 ;OPEN parm table OPENPN DW PN1 ; pathname, may be changed to PN2 DW IOBUFFER ; file buffer OPENRNUM DFB 0 ; returned ref no. P.ONLINE DFB 2 ;ONLINE parm table ONLINUNIT DFB 0 ; unit no. DW PN2S ; vol. name P.RENAME DFB 2 ;RENAME parm table DW PN2 ; orig. pathname DW PN1 ; new " P.DESTROY DFB 1 ;DESTROY parm table DW PN1 ; pathname P.PREFIX DFB 1 ;GET_PREFIX and SET_PREFIX parm table DW PN2 ; pathname P.CREATE DFB 7 ;CREATE parm table DW PN1 ; pathname DFB $C3 ; access code, $C3 = unlocked CRTYP DFB 0 ; file type DW 0 ; aux type DFB 1 ; storage type, 1 = standard CRCDAT DW 0,0 ; created date,time P.CRDIR DFB 7 ;CREATE parm table to create subdirectory DW PN1 ; pathname DFB $C3 ; access DFB $F ; file type, $F = DIR DW 0 ; aux type DFB $D ; storage type, $D = subdirectory DW 0,0 ; created date,time * * Subroutines which perform MLI calls OPENPN2 LDA #<PN2 ;Open file in PN2 BNE OPEN1 OPENPN1 LDA #<PN1 ;Open file in PN1 OPEN1 STA OPENPN+1 MLI $C8,P.OPEN, ;OPEN LDX OPENRNUM ;copy ref no. to other parm tables STX RWRNUM STX MARKRNUM STX EOFRNUM STX CLOSERNUM RTS * GETINFO LDA #$A STA P.INFO MLI $C4,P.INFO, ;GET_FILE_INFO LDX INFOSTO ;X = storage type LDY INFOTYP ;Y = file type RTS * SETINFO LDA #7 STA P.INFO MLI $C3,P.INFO, ;SET_FILE_INFO RTS * READ MLI $CA,P.RW, ;READ BCC CLCRTS1 CMP #$4C ;Ignore end of file error ($4C), BEQ CLCRTS1 ;but treat other errors as normal SECRTS1 SEC RTS CLCRTS1 CLC RTS * READSYS JSR GETINFO ;Read a system file BCS SECRTS1 LDA #$4B CPY #$FF ;Make sure it is a SYS file, or else BNE SECRTS1 ;report a "FILE TYPE MISMATCH" error JSR OPENPN1 ;Open it BCS SECRTS1 LDA #0 STA RWDATA STA RWCOUNT LDA #$20 ;Read it at $2000 STA RWDATA+1 LDA #$98 ;Read $9800 bytes max STA RWCOUNT+1 JSR READ * CLOSEALL PHP ;Close all files PHA ;save error code & status LDA #0 STA LEVEL ;set file level to 0 to close ALL files STA CLOSERNUM MLI $CC,P.CLOSE, ;CLOSE PLA PLP ;restore error code & status RTS * * NOTE: PROGRAM COUNTER MAY NOT EXCEED $1300 AT THIS POINT * DS $1300-*,0 ;FILL WITH ZEROS UP TO $1300 * LDA #1 ;This bit of code will reside at $1300, SEC ;which maps to $D400 in bank 2 of bank- RTS ;switched RAM, in case someone goes there. * CHKPOINT1 DFB $EF ;Checkpoint 1 must contain $EF * ---------------- * MAIN PROGRAM * ---------------- START JSR CLBASIC ;BASIC.SYSTEM not yet loaded into memory. LDA #1 STA DIRSTACK ;Set menu selection to first disk drive. JSR NEWDISK ;Start in Volume Commands Menu. * MAIN JSR HOME ;Set up screen display. LDX DIRLEVEL ;If DIRLEVEL=0, then in Volume Commands BNE MAIN1 ; Menu, otherwise in File Commands Menu. PRINT M.BANNER LDA #2 JSR VTABLINE ;Vtab 2, Htab 0 MAIN1 PRINT M.PREFIX MLI $C7,P.PREFIX, ;GET_PREFIX call BCS MAIN2 JSR MOVPN21 JSR PRPN1 ;Display the prefix MAIN2 LDX DIRLEVEL BEQ MAIN3 ;If in File Cmds Menu, also display the LDX #<PND ; current directory. Note that current JSR MOVPNX1 ; dir pathname moved from PND to PN1. LDA #2 ; Some file commands expect it to be there JSR VTABLINE PRINT M.DIR JSR PRPN1 MAIN3 LDA #18 JSR VTABLINE ;Vtab 18 (on 0-23 scale) LDX #40 MAIN4 LDA #$BD ;Print "=" 40 times in line 18 JSR COUT DEX BNE MAIN4 LDA #4 JSR VTABLINE ;Vtab 4 LDX DIRLEVEL BNE MAINF ;Branch if in File Commands Menu * PRINT M.VHEADER, ;Print volume commands header JSR HOME19 PRINT M.VCMDS, ;Print command list at bottom of screen LDX #>VCMDLIST LDA #<VCMDLIST LDY #VNUMCMDS-1 JSR MENU ;Display disk drives, get volume command LDA VGOTO,X STA GOTO ;Put address of cmd handler in GOTO LDA VGOTO+1,X STA GOTO+1 JMP EXECUTE ;Execute volume command * MAINF PRINT M.FHEADER, ;Print file commands header JSR HOME19 PRINT M.FCMDS, ;Print command list at bottom of screen LDX #>FCMDLIST LDA #<FCMDLIST LDY #FNUMCMDS-1 JSR MENU ;Display files, get file command LDA FGOTO,X STA GOTO ;Put address of cmd handler in GOTO LDA FGOTO+1,X STA GOTO+1 CPY #FILSPCMDS ;If command is not a file specific BCS EXECUTE ; command, then execute command now. LDX ACTIVEENT ;If it is, then GET FILENAME FIRST. BEQ MAINJ ;No files? Do nothing then. LDX MENUNUM ;Get user's file choice. JSR SETPTR ;Find the menu entry. LDA PN1L LDX MENUNUM CLC ADC T.NAMELEN,X ;If pathname exceeds 64 chars, report CMP #$41 ; a BAD PATHNAME error. BCC MAINF1 LDA #$40 JSR ERROR MAINJ JMP MAIN MAINF1 STA PN1L ;Append filename in menu entry to the LDY T.NAMELEN,X ; directory pathname already in PN1 to TAX ; make a complete pathname to the MAINF2 LDA (MENUPTR),Y ; selected file. DEX STA PN1S,X DEY BNE MAINF2 JSR MOVPN12 ;Pathname of selected file in PN1 and PN2 * EXECUTE JSR EXECUTE1 ;Now execute the command JMP MAIN EXECUTE1 JMP (GOTO) * VCMDLIST DFB CR,'O','R','A' ;List of volume commands VNUMCMDS EQU *-VCMDLIST ;Number of volume commands VGOTO DW CATVOL,ONLINE,RENAMEVOL,ONLINEALL ;Command handlers FCMDLIST DFB CR,'C','R','K','D' ;List of file specific commands FILSPCMDS EQU *-FCMDLIST ;Number of file specific commands DFB ESC,'B','P','L','S' ;Non-file specific file commands FNUMCMDS EQU *-FCMDLIST ;Total number of file commands FGOTO DW RUNCAT,COPY,RENAMEFIL,LKUNLK,DELETE ;Command handlers DW NEWDISK,BACKDIR,SETPFX,LOADRUNB,CREATEDIR * * MENU: Displays menu entries and accepts a command from user. * Input: (X=lo,A=hi) Pointer to list of ASCII commands * Y=Number of acceptable commands minus 1 * Output: Y=Command number, range 0 to input Y * X=twice Y * A,MENUNUM,CHOICE = Menu choice selected with arrow keys MCHOICES EQU 13 ;Number of entries on screen at one time MCENTER EQU 7 ;Center of screen entry CVTOP EQU 4 ;Vtab of topmost entry minus 1 MENU STX CMDLIST STA CMDLIST+1 ;Save command list pointers STY NUMCMDS MENUC LDX ACTIVEENT BEQ MENUK ;If no active entries, skip LDA CHOICE BEQ MENUC1 ;Make sure CHOICE is between CMP ACTIVEENT ;1 and ACTIVEENT; adjust it BCC MENUC2 ;as necessary STX CHOICE BCS MENUC2 MENUC1 INC CHOICE MENUC2 LDA #1 ;Calculate TOPENT; the menu entry CPX #MCHOICES+1 ;to be displayed highest in the screen BCC MENUD ;such that the current choice LDY CHOICE ;falls in the center of the screen, CPY #MCENTER ;unless choice is at beginning BCC MENUD ;or end of list. TXA ;(e.g. if CHOICE=10 and ACTIVEENT=20, then SBC CHOICE ; TOPENT=4, so entries 4 to 16 are CMP #MCHOICES-MCENTER BCS MENUC3 ; displayed and 10 is in center of screen) TXA SEC SBC #MCHOICES-1 JMP MENUD MENUC3 LDA CHOICE SBC #MCENTER-1 MENUD STA TOPENT ;TOPENT calculated STA MENUNUM MENUD1 JSR PRENTRY ;Now print each menu entry 1 at a time BCS MENUK ;Stop when bottom of display area INC MENUNUM ;or end of menu entries reached LDA ACTIVEENT CMP MENUNUM BCS MENUD1 MENUK STA STROBE ;Get keystroke MENUK1 LDA KBD BPL MENUK1 JSR UPCASE CMP #LARROW ;Left or Up arrow: BEQ MENUUP ;go up one choice CMP #UARROW BEQ MENUUP CMP #RARROW ;Right or Down arrow: BEQ MENUDOWN ;go down one CMP #DARROW BEQ MENUDOWN LDY NUMCMDS ;Not an arrow key: MENUK2 CMP (CMDLIST),Y ;Compare keystroke with list of BEQ MENUK3 ;acceptable commands DEY BPL MENUK2 BMI MENUK ;Not found: get another keystroke MENUK3 STY TEMP ;Found an acceptable command: JSR HOME19 ;Clear bottom of screen and LDY TEMP ;return result in X,Y,MENUNUM ASL TEMP LDX TEMP LDA CHOICE STA MENUNUM RTS MENUDOWN INC CHOICE ;Go down one menu entry BNE MENUC MENUUP DEC CHOICE ;Go up one JMP MENUC ;(MENUC keeps CHOICE within limits) * PRENTRY LDX MENUNUM ;Print 1 entry in menu display JSR SETPTR ;Set menu pointer to entry LDA MENUNUM SEC ;Calculate where to display it SBC TOPENT ;(relative to TOPENT at top of display) CMP #MCHOICES BCS PRENTRY3 ;Exit w/carry set if entry "off screen" ADC #CVTOP+1 JSR BASCALC LDX MENUNUM LDY #38 PRENTRY1 LDA (MENUPTR),Y ;Display using absolute screen addressing ORA #$80 CPX CHOICE BNE PRENTRY2 AND #$3F ;If MENUNUM = current choice, use INVERSE PRENTRY2 STA (BASL),Y DEY BPL PRENTRY1 CLC ;Exit w/carry clear if entry displayed PRENTRY3 RTS * M.BANNER DCI '============== ProFinder ===============' M.FHEADER DCI '=NAME============TYPE==BLOCKS==MODIFIED=' M.VHEADER DCI '=SLOT=DRIVE==VOLUME=======BLOCKS FREE===' M.FCMDS ASC '<RETURN> Run/Catalog <ESC> New Disk' DFB CR ASC '<C> Copy file <B> Back Directory' DFB CR ASC '<R> Rename <P> Set Prefix' DFB CR ASC '<K> Lock/Unlock <L> Load BASIC' DFB CR DCI '<D> Delete <S> Create Subdir' M.VCMDS ASC '<RETURN> Catalog' DFB CR ASC '<O> Online <A> Online All' DFB CR DCI '<R> Rename' M.PREFIX DCI 'Prefix: ' M.DIR DCI 'Directory: ' * ---------------------------- * VOLUME COMMAND HANDLERS * ---------------------------- * GETVOL: Get volume name & volume info, then display it to screen * Input: MENUNUM Output: volume name in PN1 GETVOL LDX MENUNUM JSR SETPTR ;Set MENUPTR to point to menu entry LDY #10 LDA #SPACE GETVOL1 STA (MENUPTR),Y ;Erase previous info by writing spaces INY CPY #39 BNE GETVOL1 JSR GETUNITNO ;Get unit no. of current entry STA ONLINUNIT MLI $C5,P.ONLINE, ;ONLINE call to get volume name BCS GETERR2 JSR MOVPN21 ;Put vol name in PN1 LDA PN1S AND #$0F ;Get length of name BEQ GETERR1 ;if 0, then error, err code in next byte TAX INX STX PN1L LDA #'/' ;Put slash in front of name STA PN1S LDX #0 LDY #12 GETVOL2 LDA PN1S,X ;Move vol name into menu entry STA (MENUPTR),Y ;for later display (at htab 12) INY INX CPX PN1L BCC GETVOL2 JSR GETINFO ;Get vol info BCS GETERR2 LDA INFOAUX ;Calculate #free blocks SEC ;free blks = AUX type (total blks) minus SBC INFOBLKS ; blocks used TAX LDA INFOAUX+1 SBC INFOBLKS+1 JSR DEC ;Convert to decimal ASCII LDY #30 JSR PUTNUM ;Put number into menu entry (htab 30) CLC BCC GETVOLEND GETERR1 LDA PN1S+1 GETERR2 SEC GETVOLEND PHP ;Save error status PHA JSR PRENTRY ;Print to screen JSR VTAB ;Restore previous screen cursor PLA PLP ;Restore error status and exit RTS * * GETUNITNO: Get unit no. from DEVLST * Input: MENUNUM Output: A = Unit no. GETUNITNO LDA ACTIVEENT ;Unit nos. stored in DEVLST SEC ;(in reverse order) SBC MENUNUM TAX LDA DEVLST,X AND #$F0 RTS * * ONLINEALL, RENAMEVOL, ONLINE, CATVOL: Volume command handlers * for <A> Online All, <R> Rename, <O> Online, <RETURN> Catalog ONLINEALL LDA #1 ;Get online vol name for each disk drive STA MENUNUM ;For MENUNUM = 1 to ACTIVEENT do: ALL1 JSR GETVOL ;get volume LDX MENUNUM INC MENUNUM CPX ACTIVEENT BCC ALL1 ;Next MENUNUM RTS * M.RENAME DCI 'New name: ' RENAMEVOL JSR GETVOL ;Get volume to rename BCS ERRORJ5 ;Error exit JSR MOVPN12 ;Move vol pathname to PN2 LDX #1 STX PN1L ;Clear PN1 except for "/" PRINT M.RENAME, ;Ask for name LDA #$AF ;Print "/" character preceding input JSR COUT JSR INPUTPN ;Input name BCS RTS8 ;Cancel rename if <ESC> pressed JSR CROUT2 MLI $C2,P.RENAME, ;RENAME call BCS ERRORJ5 * ONLINE JSR GETVOL ;Get online volume BCC RTS8 ERRORJ5 JMP ERROR ;Error exit * CATVOL JSR GETVOL ;Catalog volume BCS ERRORJ5 * CATALOG JSR READDIR ;Catalog a directory (Volume or Subdir) BCS ERRORJ5 LDX DIRLEVEL ;If successful, save current menu choice LDA CHOICE ;number in DIRSTACK so the Back Directory STA DIRSTACK,X ;command can find its way back. INC DIRLEVEL ;Directory level is 1 higher LDA #1 ;Start new dir with file choice #1 STA CHOICE RTS8 RTS * ----------------------------------- * FILE "LOAD/RUN" COMMAND HANDLERS * ----------------------------------- * <L> Load Basic command LOADRUNB JSR LOADBASIC ;Load BASIC.SYSTEM if not loaded already BCS ERRORJ2 LDA #0 ;Clear BASIC.SYSTEM's STARTUP pathname so STA STARTUP ;no startup program is run PRINT M.EXITB, ;Ask if user wants to exit JSR YN ;Get "Y" or "N" BCC RUNSYSJ ;Run BASIC if user responds "Y" RTS9 RTS M.EXITB DCI 'Exit to BASIC' * * <RETURN> Run/Catalog command RUNCAT JSR GETINFO ;Get file info BCS ERRORJ2 CPX #$0D ;If subdirectory (storage type = $D), then BEQ CATALOG ;catalog it CPY #$FF BEQ RUN ;Make sure file type is acceptable CPY #$FC ;Acceptable file types include SYS ($FF), BEQ RUN ; BAS ($FC), BIN (6), and TXT (4). CPY #$06 BEQ RUN CPY #$04 BEQ RUN NOP ;These four NOP's reserve space for one NOP ;additional file type to be accepted. NOP ;Replace NOP's with C0 nn CPY #$nn NOP ;this for type $nn: F0 05 BEQ RUN ; LDA #$4B ;If bad type, report "TYPE MISMATCH ERROR" ERRORJ2 JMP ERROR RUN PRINT M.RUN, ;Ask if user wants to run JSR YN ;Get "Y" or "N" BCS RTS9 ;Exit if "N" LDY INFOTYP ;Run program if "Y" CPY #$FF BNE RUN2 ;If SYS ($FF) type file, load it JSR LOADSYS ;and execute it. BCS ERRORJ2 BCC RUNSYSJ RUN2 JSR LOADBASIC ;If any other file type, then load BCS ERRORJ2 ; BASIC.SYSTEM first. LDX #$40 RUN3 LDA PN2,X ;Replace BASIC.SYSTEM's STARTUP pathname STA STARTUP,X ;with pathname of file user wants to run, DEX ;then execute BASIC.SYSTEM BPL RUN3 RUNSYSJ JMP RUNSYS ;Run system program M.RUN DCI 'Run this program' * * Load a system program at $2000 LOADSYS JSR CLBASIC ;Clear BASIC.SYSTEM from memory if there JSR READSYS ;Read system file PHP PHA ;Save error status LDA RWTRANS+1 CLC ADC #$20 ;Just in case sys file is so big that CMP MEMHI+1 ;it overruns menu entry storage, then BCC LOAD1 ;nullify the current directory JSR NEWDISK LOAD1 PLA PLP ;Restore error status RTS * * Load BASIC.SYSTEM into memory LOADBASIC BIT F.BASIC ;If BASIC.SYSTEM already loaded BPL LB1 ;(F.BASIC flag >= $80) then don't need LDX #<PNB ;to load it again. Just restore its JSR MOVPNX1 ;pathname to PN1 CLC RTS LB1 JSR FINDSLASH ;First set up pathname of BASIC.SYSTEM TXA ;file CLC ADC #BASICL TAY LDA #$40 CPY #$41 ;Just in case pathname too long (65 chrs) BCS SECRTS2 ;report "BAD PATHNAME" STY PN1L LDY #0 LB2 LDA BASIC,Y ;Append "BASIC.SYSTEM" file name to STA PN1S,X ;current dir pathname already in PN1 INX INY CPY #BASICL BNE LB2 JSR LOADSYS ;Load BASIC.SYSTEM BCC LB3 CMP #$46 ;If file not found, report BEQ NOBASIC ;"BASIC.SYSTEM NOT FOUND" CMP #$4B ;If wrong file type, report BNE SECRTS2 ;"BAD VERSION OF BASIC" BADBASIC LDA #$81 SECRTS2 SEC ;Other errors handle as usual RTS NOBASIC LDA #$80 SEC RTS LB3 LDX $2000 ;Make sure BASIC.SYSTEM adheres CPX #$4C ;to the "auto-run protocol", BNE BADBASIC ;or else report "BAD VERSION OF BASIC" LDX #$EE CPX $2003 BNE BADBASIC CPX $2004 BNE BADBASIC LDX $2005 CPX #$41 BCC BADBASIC LDX RWTRANS+1 BEQ BADBASIC CPX #<DIRLOAD-$2000 ;Make sure BASIC.SYSTEM is less than BCS BADBASIC ;16K in size to avoid memory conflicts LDA RWTRANS ;within program (Normally it's 10K). STA MEMLO ;OK: we got BASIC in memory now LDA RWTRANS+1 ADC #$20 ;Raise MEMLO pointer above end of loaded STA MEMLO+1 ;BASIC file to protect it from COPY cmd SEC ROR F.BASIC ;Set F.BASIC flag LDX #<PNB JSR MOVPN1X ;Save BASIC.SYSTEM's pathname to PNB CLC RTS * BASIC ASC 'BASIC.SYSTEM' BASICL EQU *-BASIC * CLBASIC LSR F.BASIC ;Clear F.BASIC flag to indicate LDA #0 ;BASIC.SYSTEM not loaded into memory STA MEMLO LDA #$1F ;Set MEMLO to $1F00; lowest memory STA MEMLO+1 ;available for copying files RTS *------------------------------------------------------------------- CHN PROFINDER.S2 ;Chain to second part of source code.